home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue43 / clinic / DataFld2.pas next >
Encoding:
Pascal/Delphi Source File  |  1999-01-01  |  1.4 KB  |  63 lines
  1. unit DataFld2;
  2.  
  3. interface
  4.  
  5. procedure Register;
  6.  
  7. implementation
  8.  
  9. uses
  10.   DsgnIntf, TypInfo, Classes, DB;
  11.  
  12. type
  13.   TDataField2Property = class(TStringProperty)
  14.   public
  15.     function GetAttributes: TPropertyAttributes; override;
  16.     procedure GetValueList(List: TStrings);
  17.     procedure GetValues(Proc: TGetStrProc); override;
  18.   end;
  19.  
  20. function TDataField2Property.GetAttributes: TPropertyAttributes;
  21. begin
  22.   Result := [paValueList, paSortList, paMultiSelect];
  23. end;
  24.  
  25. procedure TDataField2Property.GetValueList(List: TStrings);
  26. var
  27.   Instance: TPersistent;
  28.   PropInfo: PPropInfo;
  29.   DataSource: TDataSource;
  30. begin
  31.   Instance := GetComponent(0);
  32.   PropInfo := TypInfo.GetPropInfo(Instance.ClassInfo, 'DataSource');
  33.   if (PropInfo <> nil) and (PropInfo^.PropType^.Kind = tkClass) then
  34.   begin
  35.     DataSource := TObject(GetOrdProp(Instance, PropInfo)) as TDataSource;
  36.     if (DataSource <> nil) and (DataSource.DataSet <> nil) then
  37.       DataSource.DataSet.GetFieldNames(List);
  38.   end;
  39. end;
  40.  
  41. procedure TDataField2Property.GetValues(Proc: TGetStrProc);
  42. var
  43.   I: Integer;
  44.   Values: TStrings;
  45. begin
  46.   Values := TStringList.Create;
  47.   try
  48.     GetValueList(Values);
  49.     for I := 0 to Values.Count - 1 do
  50.       Proc(Values[I]);
  51.   finally
  52.     Values.Free;
  53.   end;
  54. end;
  55.  
  56. procedure Register;
  57. begin
  58.   RegisterPropertyEditor(TypeInfo(String), TComponent,
  59.     'DataField2', TDataField2Property)
  60. end;
  61.  
  62. end.
  63.